home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_5.zip / adaed / adagener.tpl < prev    next >
Text File  |  1993-02-18  |  2KB  |  86 lines
  1. WITH Unchecked_Deallocation;
  2.  
  3. GENERIC
  4.  
  5. TYPE Item IS PRIVATE;
  6.  
  7. PACKAGE Stk IS
  8.     TYPE Stack IS PRIVATE;
  9.     PROCEDURE Make_Empty(S : IN OUT Stack);
  10.     FUNCTION Is_Empty(S : Stack) RETURN BOOLEAN;
  11.     PROCEDURE Push(S : IN OUT Stack; E : Item);
  12.     PROCEDURE Pop(S : IN OUT Stack);
  13.     FUNCTION Top(S : Stack) RETURN Item;
  14.     Stack_Full  : EXCEPTION;
  15.     Stack_Empty : EXCEPTION;
  16. PRIVATE
  17.     TYPE Node;
  18.     TYPE Node_Link IS ACCESS Node;
  19.     TYPE Node IS RECORD
  20.         Value    : Item;
  21.         Previous : Node_Link;
  22.         END RECORD;
  23.     TYPE Stack IS RECORD
  24.         Last : Node_Link := NULL;
  25.         END RECORD;
  26. END Stk;
  27.  
  28. PACKAGE BODY Stk IS
  29.     Temp : Node_Link := NULL;
  30.     -- Non portable ; Instantiate Unchecked_Deallocation
  31.     PROCEDURE Free(Ptr : IN OUT Node_Link) IS
  32.     BEGIN
  33.         Ptr := NULL;
  34.     END Free;
  35.  
  36.     PROCEDURE Make_Empty(S : IN OUT Stack) IS
  37.     BEGIN
  38.         -- First release memory
  39.         WHILE S.Last /= NULL LOOP
  40.             Temp := S.Last;
  41.             S.Last := Temp.Previous;
  42.             Free(Temp);
  43.             END LOOP;
  44.     END Make_Empty;
  45.  
  46.     FUNCTION Is_Empty(S : Stack) RETURN BOOLEAN IS
  47.     BEGIN
  48.         RETURN S.Last = NULL;
  49.     END Is_Empty;
  50.  
  51.     PROCEDURE Push(S : IN OUT Stack; E : Item) IS
  52.     BEGIN
  53.         Temp := New Node;
  54.         IF Temp = NULL THEN
  55.             RAISE Stack_Full;
  56.         END IF;
  57.         Temp.Previous := S.Last;
  58.         Temp.Value := E;
  59.         S.Last := Temp;
  60.     END Push;
  61.  
  62.     PROCEDURE Pop(S : IN OUT Stack) IS
  63.     BEGIN
  64.         IF S.Last = NULL THEN
  65.             RAISE Stack_Empty;
  66.         END IF;
  67.         Temp := S.Last;
  68.         S.Last := Temp.Previous;
  69.         Free(Temp);
  70.     END Pop;
  71.  
  72.     FUNCTION Top(S : Stack) RETURN Item IS
  73.     BEGIN
  74.         IF S.Last = NULL THEN
  75.             RAISE Stack_Empty;
  76.         END IF;
  77.         RETURN S.Last.Value;
  78.     END Top;
  79. BEGIN
  80.     -- Nothing to do here!
  81.     NULL;
  82. END Stk;
  83.  
  84. -- To instantiate the package use:
  85. -- PACKAGE My_Stack IS NEW($); USE My_Stack;
  86.